home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / pasmMod.txt < prev    next >
Text File  |  1998-12-28  |  35KB  |  1,454 lines
  1. (* *********
  2.  
  3. \                    PowerPC 601 Assembler
  4.  
  5. \ Copyright 1993-1994 Xan Gregg  All Rights Reserved
  6. \    Permission is granted for internal distribution by Creative Solutions, Inc.
  7.  
  8. \    Permission also granted for Mops distribution.  Mops mods made by
  9. \    Mike Hore.
  10.  
  11. This is a basic PowerPC 601 assembler.  It uses a Forth-like syntax,
  12. but the mnemonics and operand order is usually preserved.  The exception
  13. is the branching instructions, which will be seldom used anyway since
  14. words like IF, and WHILE, are available.  Often, duplicating identical
  15. parameters is not required, such as if the source and destination
  16. registers are the same.
  17.  
  18. Examples    Motorola Syntax                Forth Syntax
  19.             add.    r1, r1, r2            r1 r2    add.,
  20.             cmpi    cr1, r3, 25            cr1 r3 25 cmpi,
  21.             crnor    crb1, crb1, crb4    crb1 crb4 crnor,
  22.                             --ALSO--    cr0 bGT cr1 bLT crnor,
  23.             lfd        fr1, 20(r2)            fr1 20 r2 lfd,
  24.             mtspr    MQ, r3                MQ r3 mtspr,
  25.             blt        target                target lt bc,
  26.             blt-    target                hint target lt bc,
  27.             bdnzl    cr2, target            cr2 target dnz bcl,
  28.  
  29. Non-PowerPC instructions are not included.
  30.  
  31. ***** *)
  32.  
  33. decimal
  34.  
  35.  
  36. \ First, the Mops version of the utility words, and a few
  37. \  others we need as well:
  38.  
  39. PPC?
  40. [IF]
  41. : dbx    postpone db  ;    immediate        \ call the debugger - db is renamed!
  42. [ELSE]
  43. : dbx    $ a9ff w,    ;  immediate
  44. [THEN]
  45.  
  46.  
  47. : DeferrErr    true abort" DEFERRed word not set"  ;
  48.  
  49. : DEFER        ['] deferrErr  vect  ;
  50. : IS        postpone ->  ;    immediate
  51.  
  52. : TOKEN@    @abs  ;
  53. : TOKEN!    reloc!  ;
  54. : TOKEN,    reloc,  ;
  55.  
  56. : NOT    0=  ;
  57.  
  58. : SCALE ( val cnt -- val' )
  59.     dup 0< IF  negate >>  ELSE  <<  THEN  ;
  60.  
  61. : HEX#        postpone $   ;  immediate
  62.  
  63. : Lo2        $ 0000FFFF  postpone literal  postpone and  ;    immediate
  64. : Hi2        $ FFFF0000  postpone literal  postpone and  ;    immediate
  65. : Hi2Lo        16 >>  ;
  66.  
  67. : ERROR"    postpone abort"  ;    immediate
  68.  
  69. : EVAL        i >r  evaluate  r> -> i  ;    \ have to save & restore I till bug fixed
  70. : OFF        false swap !  ;
  71. : ON        true swap !   ;
  72. : BLWORD    Mword  ;
  73.  
  74. : TOKEN.FOR        state IF  postpone [']  ELSE  '  THEN  ;        immediate
  75.  
  76. : RANGE        inline{ within?}  ;
  77.  
  78. : SIMM?     ( n -- n b )    \ is this a signed immediate (16 bit) value?
  79.     -32768 32767  within?  ;
  80.     
  81. \ : UIMM?  ( n -- n b )
  82. \    0 65535 within?  ;
  83.  
  84. : PSTRCPY ( addr1\addr2 -- )
  85.     over c@ 1+ cmove ;
  86.  
  87. : HOLD$        \ ( addr len -- )
  88.     dup --> hld
  89.     hld swap cmove  ;
  90.  
  91. : ALIGN4        \ pad with zero bytes till DP is 4-byte aligned
  92.     DP
  93.     4 reserve            \ just to ensure pad bytes are zero
  94.     3 +  $ fffffffc and  -> DP  ;
  95.  
  96. : #ALIGN4    \ ( n -- n' )
  97.     3 + $ fffffffc and  ;
  98.  
  99.  
  100. : code_align    PPC?
  101.                 IF        CDP 4 erase  CDP #align4  -> CDP
  102.                 ELSE    align4
  103.                 THEN  ;
  104.  
  105.  
  106. \ defer codeHere        ' here is codeHere 
  107. \ defer commaInstr     ' , is commaInstr
  108.  
  109. : codeHere        PPC? IF  CDP  ELSE  DP  THEN  ;
  110.  
  111. \ note: code, (defined in Base) already looks at PPC? and does the right thing.
  112.  
  113.  
  114.  
  115. 0 value   opInstr            \ instruction being assembled
  116.  
  117. \ : OR>INSTR  ( n -- )  opInstr or -> opInstr ;        \ experimenting:
  118. : OR>INSTR  ( n -- )  inline{ or> opInstr}  ;
  119.  
  120. : ScaleOR>INSTR  ( n\b -- )  scale or>instr ;
  121.  
  122. : >RaField  ( n -- )  16 scaleOr>Instr ;
  123. : >RbField  ( n -- )  11 scaleOr>Instr ;
  124. : >RcField  ( n -- )  6 scaleOr>Instr ;
  125. : >RdField  ( n -- )  21 scaleOr>Instr ;
  126. : >RsField  ( n -- )  21 scaleOr>Instr ;
  127. : >LField   ( n -- )  21 scaleOr>Instr ;
  128. : >TOField  ( n -- )  21 scaleOr>Instr ;
  129. : >SRField  ( n -- )  16 scaleOr>Instr ;
  130. : >SHField  ( n -- )  11 scaleOr>Instr ;
  131. : >NBField  ( n -- )  11 scaleOr>Instr ;
  132. : >MBField  ( n -- )  6 scaleOr>Instr ;
  133. : >MEField  ( n -- )  1 scaleOr>Instr ;
  134. : >DispField ( n -- ) Lo2 or>Instr ;
  135. : >ImmField  ( n -- ) Lo2 or>Instr ;
  136. : >Imm5Field ( n -- ) Lo2 16 <<  or>Instr ;
  137.  
  138. hex# fa970000 constant RegisterID
  139. hex# fa870000 constant FRegisterID
  140. hex# fa770000 constant CRegisterID
  141. hex# fa670000 constant CBRegisterID
  142. hex# fa270000 constant VRegisterID
  143. hex# fa570000 constant SPRegisterID
  144. hex# fa470000 constant ModifierID
  145. hex# fa370000 constant ConditionID
  146.  
  147. : MODIFIER  ( value -- | create a register constant)
  148.     ModifierID or constant ;
  149.  
  150. : MODIFIER?  ( [value] -- [value\true] | [false] )
  151.     depth 0 > IF dup Hi2 ModifierID = ELSE false THEN ;
  152.  
  153. : REGISTER  ( value -- | create a register constant)
  154.     RegisterID or constant ;
  155.  
  156. : REGISTER#  ( value -- n )
  157.     Lo2 ;
  158.  
  159. : REGISTER?  ( [value] -- [value\true] | [false] )
  160.     depth 0 > IF dup Hi2 RegisterID = ELSE false THEN ;
  161.  
  162. : REGISTER#?  ( [value] -- [value\true] | [false] )
  163.     register? dup if swap register# swap then  ;
  164.  
  165. : NEEDREGISTER  ( [value] -- )
  166.     register? not error" EXPECTED A REGISTER" ;
  167.     
  168. : NEEDREGISTER#  ( [value] -- n )
  169.     register#? not error" EXPECTED A REGISTER" ;
  170.     
  171. : DECLAREREGISTERS  ( -- )
  172.     32 0 DO
  173.         i 0 <# 2dup #s "  register R" hold$ 2drop #s #> eval
  174.     LOOP ;
  175.  
  176. : FREGISTER  ( value -- | create a register constant)
  177.     FRegisterID or constant ;
  178.  
  179. : FREGISTER?  ( [value] -- [value\true] | [false] )
  180.     depth 0 > IF dup Hi2 FRegisterID = ELSE false THEN ;
  181.  
  182. : FREGISTER#?  ( [value] -- [value\true] | [false] )
  183.     fregister? dup if swap register# swap then  ;
  184.  
  185. : NEEDFREGISTER  ( [value] -- )
  186.     fregister? not error" EXPECTED A FREGISTER" ;
  187.     
  188. : NEEDFREGISTER#  ( [value] -- )
  189.     fregister#? not error" EXPECTED A FREGISTER" ;
  190.     
  191. : DECLAREFREGISTERS  ( -- )
  192.     32 0 DO
  193.         i 0 <# 2dup #s "  fregister FR" hold$ 2drop #s #> eval
  194.     LOOP
  195.  
  196.     32 0 DO
  197.         i 0 <# 2dup #s "  fregister F" hold$ 2drop #s #> eval
  198.     LOOP
  199. ;
  200.  
  201. : CREGISTER  ( value -- | create a register constant)
  202.     CRegisterID or constant ;
  203.  
  204. : CREGISTER?  ( [value] -- [value\true] | [false] )
  205.     depth 0 > IF dup Hi2 CRegisterID = ELSE false THEN ;
  206.  
  207. : CREGISTER#?  ( [value] -- [value\true] | [false] )
  208.     cregister? dup if swap register# swap then  ;
  209.  
  210. : NEEDCREGISTER  ( [value] -- )
  211.     cregister? not error" EXPECTED A CREGISTER" ;
  212.     
  213. : DECLARECREGISTERS  ( -- )
  214.     8 0 DO
  215.         i 0 <# 2dup #s "  cregister CR" hold$ 2drop #s #> eval
  216.     LOOP ;
  217.  
  218. : CBREGISTER  ( value -- | create a register constant)
  219.     CBRegisterID or constant ;
  220.  
  221. : CBREGISTER?  ( [value] -- [value\true] | [false] )
  222.     depth 0 > IF dup Hi2 CBRegisterID = ELSE false THEN ;
  223.  
  224. : CBREGISTER#?  ( [value] -- [value\true] | [false] )
  225.     cbregister? dup if swap register# swap then  ;
  226.  
  227. : NEEDCBREGISTER  ( [value] -- )
  228.     cbregister? not error" EXPECTED A CBREGISTER" ;
  229.     
  230. : DECLARECBREGISTERS  ( -- )
  231.     32 0 DO
  232.         i 0 <# 2dup #s "  cbregister CRB" hold$ 2drop #s #> eval
  233.     LOOP ;
  234.  
  235.  
  236. : VREGISTER  ( value -- | create a register constant)
  237.     VRegisterID or constant ;
  238.  
  239. : VREGISTER?  ( [value] -- [value\true] | [false] )
  240.     depth 0 > IF dup Hi2 VRegisterID = ELSE false THEN ;
  241.  
  242. : VREGISTER#?  ( [value] -- [value true] | [false] )
  243.     vregister? dup if swap register# swap then  ;
  244.  
  245. : NEEDVREGISTER  ( [value] -- )
  246.     vregister? not error" EXPECTED A VREGISTER" ;
  247.     
  248. : NEEDVREGISTER#  ( [value] -- )
  249.     vregister#? not error" EXPECTED A VREGISTER" ;
  250.     
  251. : DECLAREVREGISTERS  ( -- )
  252.     32 0 DO
  253.         i 0 <# 2dup #s "  vregister V" hold$ 2drop #s #> eval
  254.     LOOP ;
  255.  
  256.  
  257. : SPREGISTER  ( value -- | create a register constant)
  258.     dup 31 and 5 scale swap -5 scale or SPRegisterID or constant ;
  259.  
  260. : SPREGISTER?  ( [value] -- [value\true] | [false] )
  261.     depth 0 > IF dup Hi2 SPRegisterID = ELSE false THEN ;
  262.  
  263. : NEEDSPREGISTER  ( [value] -- )
  264.     spregister? not error" EXPECTED An SPREGISTER" ;
  265.     
  266. : CONDITION  ( value -- | create a condition constant)
  267.     conditionID or
  268.     constant ;
  269.  
  270. : CONDITION?  ( [value] -- [value\true] | [false] )
  271.     depth 0 > IF dup Hi2 conditionID = ELSE false THEN ;
  272.  
  273. : NEEDCONDITION  ( [value] -- )
  274.     condition? not error" EXPECTED A CONDITION" ;
  275.     
  276. : MODIFIERVALUE  ( value -- n )
  277.     Lo2 ;
  278.  
  279. : CONDITIONVALUE  ( value -- n )
  280.     Lo2 ;
  281.  
  282. \ branchHint is a one-shot set by 'hint' and cleared by the next branch instr.
  283. variable branchHint
  284. branchHint off
  285.  
  286. \ ASSEMBLER.WORDS
  287.  
  288. : hint    branchHint on ;
  289.  
  290. DeclareRegisters
  291. DeclareFRegisters
  292. DeclareVRegisters
  293. DeclareCRegisters
  294. DeclareCBRegisters
  295.  
  296. 0 SPRegister    MQ
  297. 1 SPRegister    XER
  298. 4 SPRegister    RTCU
  299. 5 SPRegister    RTCL
  300. 6 SPRegister    DEC
  301. 8 SPRegister    LR
  302. 9 SPRegister    CTR
  303.  
  304. : bLT  ( [cr] -- crb )  CRegister#? not IF 0 THEN 4*    CBRegisterID or ;
  305. : bGT  ( [cr] -- crb )  CRegister#? not IF 0 THEN 4* 1+ CBRegisterID or ;
  306. : bEQ  ( [cr] -- crb )  CRegister#? not IF 0 THEN 4* 2+ CBRegisterID or ;
  307. : bSO  ( [cr] -- crb )  CRegister#? not IF 0 THEN 4* 3+ CBRegisterID or ;
  308.  
  309. create condArea 10 allot
  310.  
  311. : COND$        condArea count  ;
  312.  
  313.  
  314. : COND3  ( bit#\pos? -- )
  315.     blword condArea pstrcpy
  316.     IF  hex# 180  ELSE  hex# 080  THEN or
  317.     dup            0 <# cond$ hold$ "  condition " hold$ #s #> eval
  318.     hex# f7f and
  319.     dup ( 1+)    0 <# cond$ hold$ "  condition dnz" hold$ #s #> eval
  320.     hex# 040 or 0 <# cond$ hold$ "  condition dz" hold$ #s #> eval
  321.     ;
  322.  
  323. 0 1 cond3 lt
  324. 1 1 cond3 gt
  325. 2 1 cond3 eq
  326. 3 1 cond3 so
  327. 4 1 cond3 un
  328. 0 0 cond3 nl
  329. 1 0 cond3 ng
  330. 2 0 cond3 ne
  331. 3 0 cond3 ns
  332. 4 0 cond3 nu
  333. 0 0 cond3 ge
  334. 1 0 cond3 le
  335. hex# 200 condition dnz
  336. hex# 240 condition dz
  337. hex# 280 condition tr
  338.  
  339. 1 modifier LONG        \ for cmp instruction
  340. 0 modifier WD        \ for cmp instruction        ** note - can't use WORD
  341.  
  342.  
  343. \ LOCAL.WORDS
  344.  
  345.  
  346. \ GetDAB  ( dreg [areg] [breg] tester -- | inserts D, A, and B regs into opInstr)
  347.     \ A and B are optional
  348.  
  349. : GetDAB  ( d a b ) { tester \ d a b -- }    \ inserts D, A, and B regs into opInstr)
  350.  
  351.     tester execute not error" expected a register"
  352.     -> b
  353.     tester execute not IF    \ 1 register: d,d,d
  354.         b -> a
  355.         a -> d
  356.     ELSE
  357.         -> a
  358.         tester execute IF    \ 3 registers: d,a,b
  359.             -> d
  360.         ELSE                \ 2 registers: d,d,a
  361.             a -> d
  362.         THEN
  363.     THEN
  364.     d >RdField a >RaField b >RbField ;
  365.  
  366.  
  367. : GetDB  ( d b ) { tester \ d b -- }    \ inserts D and B regs into opInstr)
  368.  
  369.     tester execute not error" expected a register"
  370.     -> b
  371.     tester execute not
  372.     IF                            \ 1 register: d,d
  373.         b -> d
  374.     ELSE
  375.         -> d
  376.     THEN
  377.     d >RdField  b >RbField        \ RaField stays zero
  378. ;
  379.  
  380.  
  381. : GETRDAB  ( dreg [areg] [breg] -- )
  382.     token.for register#? getDAB ;
  383.  
  384. : GETFRDAB  ( dreg [areg] [breg] -- )
  385.     token.for fregister#? getDAB ;
  386.  
  387. : getCRBdab  ( dreg [areg] [breg] -- )
  388.     token.for cbregister#? getDAB ;
  389.  
  390. : getVdab  ( dreg [areg] [breg] -- )
  391.     token.for vregister#? getDAB  ;
  392.  
  393. : getVdb  ( dreg [areg] [breg] -- )
  394.     token.for vregister#? getDB  ;
  395.  
  396.  
  397. \ Checking words for immediates
  398.  
  399. : ?SIMM  ( n -- )
  400.     simm? nip not error" EXPECTED A SIMM" ;
  401.  
  402. : ?UIMM  ( n -- )
  403.     0 65535 range nip not error" EXPECTED A UIMM" ;
  404.  
  405. : ?UIMM5  ( n -- )
  406.     0 31 range nip not error" EXPECTED A 5-bit UIMM" ;
  407.  
  408. : ?UIMM4  ( n -- )
  409.     0 15 range nip not error" EXPECTED A 4-bit UIMM" ;
  410.  
  411. : ?SIMM5  ( n -- )
  412.     -16 15 range nip not error" EXPECTED A 5-bit UIMM" ;
  413.  
  414.  
  415. \ GETDAIMM  ( dreg [areg] simm tester -- | inserts D, and A regs and SIMM into opInstr)
  416. \  A is optional
  417.  
  418. : GETDAIMM  ( d [a] ) { simm tester \ d a -- }
  419.  
  420.     simm tester execute
  421.     register#? not error" expected a register"
  422.     -> a
  423.     register#? not IF a THEN -> d
  424.     d >RdField  a >RaField  simm >ImmField
  425. ;
  426.  
  427. : getVdbUIMM5  ( d [b] ) { uimm5 \ d b -- }
  428.     uimm5 ?uimm5
  429.     getVdb
  430.     uimm5 >Imm5Field
  431. ;
  432.  
  433. : getVdSIMM5  ( d ) { simm5 \ d -- }
  434.     simm5 ?simm5
  435.     getVdb
  436.     simm5 >Imm5Field
  437. ;
  438.  
  439. : getVdabSH  ( d [a] [b] ) { uimm4 \ d a b -- }
  440.     uimm4 ?uimm4
  441.     getVdab
  442.     uimm4  5 <<  or>Instr
  443. ;
  444.  
  445.  
  446. : GETRDASIMM  ( dreg\[areg]\simm -- )
  447.     token.for ?simm  GetDAImm ;
  448.  
  449. : GETRDAUIMM  ( dreg\[areg]\simm -- )
  450.     token.for ?uimm GetDAImm ;
  451.  
  452. : GETRDAIMM  ( dreg [areg] imm -- )
  453.     token.for drop  GetDAImm  ;
  454.  
  455.  
  456.  
  457. \ GETDA  ( dreg\[areg]\tester -- | inserts D and A regs into opInstr)
  458.     \ A is optional
  459. \    0 0 locals| d a tester |
  460.  
  461. : GETDA  ( d [a] ) { tester \ d a -- }
  462.  
  463.     tester execute not error" expected a register"
  464.     -> a
  465.     tester execute not IF a THEN -> d
  466.     d >RdField  a >RaField ;
  467.  
  468. : GETRDA  ( dreg [areg] -- )
  469.     token.for register#? GetDA ;
  470.  
  471. : GETRASBIMM  ( [areg]\sreg\[breg]|[imm] -- )
  472.     register#? IF >RbField ELSE >ImmField THEN
  473.     needRegister# dup >R >RsField
  474.     register#? IF R> drop ELSE R> THEN >RaField ;
  475.  
  476. : GETRASB  ( [areg]\sreg\breg -- )
  477.     needRegister# >RbField
  478.     needRegister# dup >R >RsField
  479.     register#? IF R> drop ELSE R> THEN >RaField ;
  480.  
  481. : GETRASIMM  ( [areg]\sreg\imm -- )
  482.     dup ?uimm
  483.     >ImmField
  484.     needRegister# dup >R >RsField
  485.     register#? IF R> drop ELSE R> THEN >RaField ;
  486.  
  487. : GETCRLAB  ( [crReg]\[L]\areg\breg -- )
  488.     needRegister# >RbField
  489.     needRegister# >RaField
  490.     modifier? IF ModifierValue  >LField THEN
  491.     cregister#? if 23 ScaleOR>INSTR then ;
  492.  
  493. : (getCrLaImm)
  494.     >ImmField
  495.     needRegister# >RaField
  496.     modifier? IF ModifierValue  >LField THEN
  497.     cregister#? if 23 ScaleOR>INSTR then ;
  498.  
  499. : GETCRLAIMM  ( [crReg]\[L]\areg\imm -- )
  500.     dup ?simm  (getCrLaImm)  ;
  501.  
  502. : GETCRLAUIMM
  503.     dup ?uimm  (getCrLaImm)  ;
  504.  
  505.  
  506. : GETCRFAB  ( [crReg]\areg\breg -- )
  507.     needFRegister# >RbField
  508.     needFRegister# >RaField
  509.     cregister#? if 23 ScaleOR>INSTR then ;
  510.  
  511. : GETRAB  ( areg\breg -- )
  512.     needRegister# >RbField
  513.     needRegister# >RaField ;
  514.  
  515. : GETRAS  ( areg\[sreg] -- ) { \ s -- }
  516. \    needRegister# locals| S |
  517.     needRegister# -> s
  518.     s >RsField
  519.     register#? not IF s THEN >RaField ;
  520.  
  521. : GETFRDB  ( dfreg\[bfreg] -- ) { \ b -- }
  522. \    needFRegister# locals| B |
  523.     needFRegister# -> b
  524.     b >RbField
  525.     fregister#? not IF b THEN >RdField ;
  526.  
  527. : GetNull  ( -- )
  528.     ;
  529.  
  530. : GetRsab  ( [sreg]\areg\breg -- )
  531.     needRegister# >RbField
  532.     needRegister# dup >R >RaField
  533.     register#? IF R> drop ELSE R> THEN >RsField ;
  534.  
  535. : GetCRds  ( CRd\CRs -- )
  536.     needCRegister register# 18 ScaleOR>INSTR
  537.     needCRegister register# 23 ScaleOR>INSTR ;
  538.  
  539. : GetCRd  ( CRd -- )
  540.     needCRegister register# 23 ScaleOR>INSTR ;
  541.  
  542. : GetRd  ( Rd -- )
  543.     needRegister# >RdField ;
  544.  
  545. : GetFRd  ( dfreg -- )
  546.     needFRegister#  >RdField ;
  547.  
  548. : GetRdSPR  ( Rd\SPR -- )
  549.     needSPRegister register# 11 ScaleOR>INSTR
  550.     needRegister# >RdField ;
  551.  
  552. : GetRdSR  ( Rd\SR -- )
  553.     >SRField
  554.     needRegister# >RdField ;
  555.  
  556. : GetRdb  ( [Rd]\Rb -- )
  557.     needRegister# dup >R >RbField
  558.     register#? IF R> drop ELSE R> THEN >RdField ;
  559.  
  560. : getCRMRs  ( CRM\Rs -- )
  561.     needRegister# >RsField
  562.     255 and 12 ScaleOR>INSTR ;        \ bug fixed 25-Aug-94 via msg from xg
  563.  
  564. : getCRBd  ( CRBd -- )
  565.     needCBRegister register# >RdField ;
  566.  
  567. : getFMFrb  ( FM\FRb -- )
  568.     needFRegister# >RbField
  569.     255 and 17 ScaleOR>INSTR ;
  570.  
  571. : getCRdBImm  ( CRd\Imm -- )
  572.     15 and 12 ScaleOR>INSTR
  573.     needCRegister register# 23 ScaleOR>INSTR ;
  574.  
  575. : GetRs  ( sreg -- )
  576.     needRegister# >RsField ;
  577.  
  578. : GetSPRRs  ( SPR\Rs -- )
  579.     needRegister# >RsField
  580.     needSPRegister register# 11 ScaleOR>INSTR ;
  581.  
  582. : getSRRs  ( SR\Rs -- )
  583.     needRegister# >RsField
  584.     15 and >SRField ;
  585.  
  586. : getRsb  ( [Rs]\Rb -- )
  587.     needRegister# dup >R >RbField
  588.     register#? IF R> drop ELSE R> THEN >RsField ;
  589.  
  590. : getRasSHMBME  ( [Ra]\Rs\SH\MB\ME -- )
  591.     31 and >MEField
  592.     31 and >MBField
  593.     31 and >SHField
  594.     needRegister# dup >R >RsField
  595.     register#? IF R> drop ELSE R> THEN >RaField ;
  596.  
  597. : getRasbMBME  ( [Ra]\Rs\Rb\MB\ME -- )
  598.     31 and >MEField
  599.     31 and >MBField
  600.     needRegister# >SHField
  601.     needRegister# dup >R >RsField
  602.     register#? IF R> drop ELSE R> THEN >RaField ;
  603.  
  604. : getRasSH  ( [Ra]\Rs\SH -- )
  605.     31 and >SHField
  606.     needRegister# dup >R >RsField
  607.     register#? IF R> drop ELSE R> THEN >RaField ;
  608.  
  609. : getRsaDisp  ( Rs\[disp\]Ra -- )
  610.     needRegister# >RaField
  611.     simm? if >DispField then
  612.     needRegister# >RsField ;
  613.  
  614. : getFRsRaDisp  ( FRs\[disp\]Ra -- )
  615.     needRegister# >RaField
  616.     simm? if >DispField then
  617.     needFRegister# >RsField ;
  618.  
  619. : getFRsRab  ( FRs\Ra\Rb -- )
  620.     needRegister# >RbField
  621.     needRegister# >RaField
  622.     needFRegister# >RsField ;
  623.  
  624. : getRsaNB  ( [Ra]\Rs\NB -- )
  625.     31 and >NBField
  626.     needRegister# dup >R >RaField
  627.     register#? IF R> drop ELSE R> THEN >RsField ;
  628.  
  629.  
  630. : getRb  ( Rb -- )
  631.     needRegister# >RbField ;
  632.  
  633. : getVb  ( Vb -- )
  634.     needVRegister# >RbField ;
  635.  
  636. : getVd  ( Vd -- )
  637.     needVRegister# >RdField ;
  638.  
  639. : getTORab  ( TO Ra Rb -- )
  640.     needRegister# >RbField
  641.     needRegister# >RaField
  642.     31 and >TOField ;
  643.  
  644. : getTORaSImm  ( TO Ra Simm -- )
  645.     dup ?simm >ImmField
  646.     needRegister# >RaField
  647.     31 and >TOField ;
  648.  
  649. : getFRdRaDisp  ( FRd [disp] Ra -- )
  650.     needRegister# >RaField
  651.     simm? if >DispField then
  652.     needFRegister# >RdField ;
  653.  
  654. : getFRdRab  ( FRd Ra Rb -- )
  655.     needRegister# >RbField
  656.     needRegister# >RaField
  657.     needFRegister# >RdField ;
  658.  
  659. : getRdaDisp  ( Rd [disp] Ra -- )
  660.     needRegister# >RaField
  661.     simm? if >DispField then
  662.     needRegister# >RdField ;
  663.  
  664. : getRdaNB  ( Rd Ra nb -- )
  665.     31 and >NBField
  666.     needRegister# >RaField
  667.     needRegister# >RdField ;
  668.  
  669. : getFRdacb  ( [FRd] FRa FRc FRb -- )
  670.     needFRegister# >RbField
  671.     needFRegister# >RcField
  672.     needFRegister# dup >R >RaField
  673.     fregister#? IF R> drop ELSE R> THEN >RdField ;
  674.  
  675. : getFRdac  ( [FRd] FRa FRc -- )
  676.     needFRegister# >RcField
  677.     needFRegister# dup >R >RaField
  678.     fregister#? IF R> drop ELSE R> THEN >RdField ;
  679.  
  680.  
  681. : getVdabc  ( [VRd] VRa VRb VRc -- )
  682.     \ Note: vector mult and accumulate multiplies A and B then adds C,
  683.     \  whereas fmadd multiplies A and C then adds B, probably for historical
  684.     \  reasons (i.e. POWER).  However in assembler we always put the
  685.     \  addition operand last.
  686.  
  687.     needVRegister# >RcField
  688.     needVRegister# >RbField
  689.     needVRegister# dup >R >RaField
  690.     fregister#? IF R> drop ELSE R> THEN >RdField
  691. ;
  692.  
  693. : getabVd  ( Vd a b ) { \ d a b -- }
  694.         \ a and b are GPRs, Vd is a VR - i.e. vector loads & stores.  We
  695.         \  insist on all reg specifiers being present.
  696.  
  697.     needRegister#  >RbField
  698.     needRegister#  >RaField
  699.     needVregister  >RdField
  700. ;
  701.  
  702. : getVstrm  { strm# -- }
  703.     strm# 21 scaleOr>Instr
  704. ;
  705.  
  706. : getabVstrm ( a b ) { strm# -- }
  707.     needRegister#  >RbField
  708.     needRegister#  >RaField
  709.     strm# getVstrm
  710. ;
  711.  
  712.  
  713. : checkAddress  ( addr\numBits -- addr )
  714.     over 3 and error" INVALID ADDRESS - NOT MULTIPLE OF 4"
  715.     1 swap 1- scale dup negate swap 1- 
  716.     range not error" INVALID ADDRESS - OUT OF RANGE" ;
  717.  
  718. : ?hint    \ set the branch bit if requested by the one-shot
  719.     branchHint @ if
  720.         branchHint off
  721.         1 21 scaleOr>Instr
  722.     then ;
  723.  
  724. : getAbsAddr
  725.     26 checkAddress
  726. \    hex# 3FF,FFFC and or>Instr ?hint ;
  727.     hex# 3FFFFFC and or>Instr ?hint ;
  728.  
  729. : getRelAddr  ( addr -- )
  730.     codehere - getAbsAddr ;
  731.  
  732. : getBOBI  ( [crreg]\[cond] -- )
  733.     condition? IF
  734.         conditionValue 16 ScaleOr>Instr
  735.     ELSE
  736.         hex# 280 16 ScaleOr>Instr    \ branch always if no condition
  737.     THEN
  738.     cregister#? IF
  739.         18 ScaleOr>Instr
  740.     THEN ?hint ;
  741.  
  742. : getUncondBOBI    ( -- )
  743.     hex# 280 16 ScaleOr>Instr ;    \ branch always
  744.  
  745.  
  746. : getBOBIAddr  ( addr\[cond]\[cond] -- )
  747.     condition? IF
  748.         conditionValue 16 ScaleOr>Instr
  749.     ELSE
  750.         hex# 280 16 ScaleOr>Instr    \ branch always if no condition
  751.     THEN
  752.     opInstr 2 and not IF codehere - THEN
  753.     13 checkAddress hex# fffc and or>Instr
  754.     cregister#? IF
  755.         18 ScaleOr>Instr
  756.     THEN ?hint ;
  757.  
  758. \ -------------------------------------------------------
  759.  
  760. : OP  ( primOp secOp -- )        \ main asm defining word
  761.  
  762.     Mword find NIF cr ." Internal pasm error!"  1 die  THEN
  763.     >r
  764.     <builds  ( opcode1 opcode2 -- ) swap 26 scale or ,  r> token,
  765.  
  766.     does> ( pfa -- | lays down instruction )
  767.         dup @ -> opInstr
  768.         4+ token@ execute
  769.         opInstr code,  ;
  770.  
  771.  
  772. : OP2  ( primOp secOp -- )
  773.         \ some Altivec instructions have the secondary opcode as listed
  774.         \  in the manual shifted left by one.  It's easier to take care
  775.         \  of that here rather than change all the numbers and probably
  776.         \  introduce errors.
  777.  
  778.     2*  OP  ;
  779.  
  780.  
  781. create OPCODEArea 10 allot
  782. : OPCODE$    opcodeArea count  ;
  783.  
  784. create GETTERAREA 20 allot
  785. : GETTER$    getterArea count  ;
  786.  
  787. : DEFININGTEXT  ( n1 n2 -- 0 | called from inside <# #> )
  788. \ mh's note - we take care of converting the numbers to doubles here.
  789.  
  790.     0 swap  0
  791.     opcode$ hold$ BL hold getter$ hold$ "  OP " hold$ #S BL hold 2drop #s ;
  792.  
  793. \ : evaluate.string  ( addr -- )
  794. \    cr dup count type
  795. \    evaluate.string
  796. \    40 >col here 14 .r ;
  797.     
  798. : OPo.  ( opcode1 opcode2 -- super asm instruction defining word )
  799.     blword getterArea pstrcpy
  800.     blword opcodeArea pstrcpy
  801.     2* 2dup        <# " ,"        hold$ definingText #> eval
  802.     2dup 1+        <# " .,"    hold$ definingText #> eval
  803.     2dup 1024 + <# " o,"    hold$ definingText #> eval
  804.          1025 + <# " o.,"    hold$ definingText #> eval
  805. ;
  806.  
  807. : OP.  ( opcode1 opcode2 -- super asm instruction defining word )
  808.     blword getterArea pstrcpy
  809.     blword opcodeArea pstrcpy
  810.     2* 2dup    <# " ,"   hold$ definingText #> eval
  811.          1+    <# " .,"  hold$ definingText #> eval
  812. ;
  813.  
  814.  
  815. \ Vector ops with a dot, have the Rc bit in a different place
  816. \  in the instruction (bit 21, not 31).
  817.  
  818. : OPv.  ( opcode1 opcode2 -- super asm instruction defining word )
  819.     blword getterArea pstrcpy
  820.     blword opcodeArea pstrcpy
  821.     2dup        <# " ,"   hold$ definingText #> eval
  822.     $ 400 or    <# " .,"  hold$ definingText #> eval
  823. ;
  824.  
  825.  
  826. \ ASSEMBLER.WORDS
  827.  
  828.  
  829. 31 266    OPo.    getRdab        add
  830. 31  10    OPo.    getRdab        addc
  831. 31 138    OPo.    getRdab        adde
  832. 14    0    OP        getRdaSimm    addi,
  833. 12    0    OP        getRdaSimm    addic,
  834. 13    0    OP        getRdaSimm    addic.,
  835. 15    0    OP        getRdaSimm    addis,
  836. 31 234    OPo.    getRda        addme
  837. 31 202    OPo.    getRda        addze
  838. 31  28    OP.        getRasb        and
  839. 31  60    OP.        getRasb        andc
  840. 28  0    OP        getRasImm    andi.,
  841. 29  0    OP        getRasImm    andis.,
  842.  
  843. ( ** branch instructions ** )
  844. 18    0    OP        getRelAddr    b,
  845. 18    2    OP        getAbsAddr    ba,
  846. 18    1    OP        getRelAddr    bl,
  847. 18    3    OP        getAbsAddr    bla,
  848. 16    0    OP        getBOBIAddr    bc,
  849. 16    2    OP        getBOBIAddr    bca,
  850. 16    1    OP        getBOBIAddr    bcl,
  851. 16    3    OP        getBOBIAddr    bcla,
  852. 19 1056    OP        getBOBI        bcctr,
  853. 19 1057    OP        getBOBI        bcctrl,
  854. 19    32    OP        getBOBI        bclr,
  855. 19    33    OP        getBOBI        bclrl,
  856. 19 1056    OP        getUncondBOBI    bctr,
  857. 19 1057    OP        getUncondBOBI    bctrl,
  858. 19    32    OP        getUncondBOBI    blr,
  859. 19    33    OP        getUncondBOBI    blrl,
  860.  
  861. 31  0    OP        getCrLAB    cmp,
  862. 11  0    OP        getCrLAImm    cmpi,
  863. 31  64    OP        getCrLAB    cmpl,
  864. 10  0    OP        getCrLAUImm    cmpli,
  865. 31  26    OP.        getRas        cntlzw
  866. 19 514  OP        getCRBdab    crand,
  867. 19 258  OP        getCRBdab    crandc,
  868. 19 578  OP        getCRBdab    creqv,
  869. 19 450  OP        getCRBdab    crnand,
  870. 19  66  OP        getCRBdab    crnor,
  871. 19 898  OP        getCRBdab    cror,
  872. 19 834  OP        getCRBdab    crorc,
  873. 19 386  OP        getCRBdab    crxor,
  874. 31 172    OP        getRab        dcbf,
  875. 31 940    OP        getRab        dcbi,
  876. 31 108    OP        getRab        dcbst,
  877. 31 556    OP        getRab        dcbt,
  878. 31 492    OP        getRab        dcbtst,
  879. 31 2028    OP        getRab        dcbz,
  880. 31 491    OPo.    getRdab        divw
  881. 31 459    OPo.    getRdab        divwu
  882. 31 620    OP        getRdab        eciwx,
  883. 31 876    OP        getRdab        ecowx,
  884. 31 1708    OP        getNull        eieio,
  885. 31 284    OP.        getRasb        eqv
  886. 31 954    OP.        getRas        extsb
  887. 31 922    OP.        getRas        extsh
  888.  
  889. 63 264    OP.        getFRdb        fabs
  890. 63  21    OP.        getFRdab    fadd
  891. 59  21    OP.        getFRdab    fadds
  892. 63  64    OP        getCRFab    fcmpo,
  893. 63  0    OP        getCRFab    fcmpu,
  894. 63  14    OP.        getFRdb        fctiw
  895. 63  15    OP.        getFRdb        fctiwz
  896. 63  18    OP.        getFRdab    fdiv
  897. 59  18    OP.        getFRdab    fdivs
  898. 63  29    OP.        getFRdacb    fmadd
  899. 59  29    OP.        getFRdacb    fmadds
  900. 63  72    OP.        getFRdb        fmr
  901. 59  28    OP.        getFRdacb    fmsub
  902. 59  28    OP.        getFRdacb    fmsubs
  903. 63  25    OP.        getFRdac    fmul
  904. 59  25    OP.        getFRdac    fmuls
  905. 63  136    OP.        getFRdb        fnabs
  906. 63  40    OP.        getFRdb        fneg
  907. 63  31    OP.        getFRdacb    fnmadd
  908. 59  31    OP.        getFRdacb    fnmadds
  909. 63  30    OP.        getFRdacb    fnmsub
  910. 59  30    OP.        getFRdacb    fnmsubs
  911. 63  12    OP.        getFRdb        frsp
  912. 63  20    OP.        getFRdab    fsub
  913. 59  20    OP.        getFRdab    fsubs
  914.  
  915. 31 1964 OP        getRab        icbi,
  916. 19 300    OP        getNull        isync,
  917. 34  0    OP        getRdaDisp    lbz,
  918. 35  0    OP        getRdaDisp    lbzu,
  919. 31 238    OP        getRdab        lbzux,
  920. 31 174    OP        getRdab        lbzx,
  921. 50  0    OP        getFRdRaDisp lfd,
  922. 51  0    OP        getFRdRaDisp lfdu,
  923. 31 1262    OP        getFRdRab    lfdux,
  924. 31 1198    OP        getFRdRab    lfdx,
  925. 48  0    OP        getFRdRaDisp lfs,
  926. 49  0    OP        getFRdRaDisp lfsu,
  927. 31 1134    OP        getFRdRab    lfsux,
  928. 31 1070    OP        getFRdRab    lfsx,
  929. 31 1198    OP        getFRdRab    lfdx,
  930. 42  0    OP        getRdaDisp    lha,
  931. 43  0    OP        getRdaDisp    lhau,
  932. 31 750    OP        getRdab        lhaux,
  933. 31 686    OP        getRdab        lhax,
  934. 31 1580    OP        getRdab        lhbrx,
  935. 40  0    OP        getRdaDisp    lhz,
  936. 41  0    OP        getRdaDisp    lhzu,
  937. 31 622    OP        getRdab        lhzux,
  938. 31 558    OP        getRdab        lhzx,
  939. 46  0    OP        getRdaDisp    lmw,
  940. 31 1194    OP        getRdaNb    lswi,
  941. 31 1066    OP        getRdab        lswx,
  942. 31  40    OP        getRdab        lwarx,
  943. 31 1068    OP        getRdab        lwbrx,
  944. 32  0    OP        getRdaDisp    lwz,
  945. 33  0    OP        getRdaDisp    lwzu,
  946. 31 110    OP        getRdab        lwzux,
  947. 31  46    OP        getRdab        lwzx,
  948.  
  949. 19  0    OP        getCRds        mcrf,
  950. 63 128    OP        getCRds        mcrfs,
  951. 31 1024    OP        getCRd        mcrxr,
  952. 31  38    OP        getRd        mfcr,
  953. \ 63  583    OP.        getRd        mffs
  954. 63  583    OP.        getFRd        mffs
  955. 31  166    OP        getRd        mfmsr,
  956. 31  678    OP        getRdSPR    mfspr,
  957. 31 1190    OP        getRdSR        mfsr,
  958. 31 1318    OP        getRdb        mfsrin,
  959. 31  288    OP        getCRMRs    mtcrf,
  960. 63  70    OP.        getCRBd        mtfsb0
  961. 63  38    OP.        getCRBd        mtfsb1
  962. \ 31  711 OP.        getFMFrb    mtfsf
  963. 63  711 OP.        getFMFrb    mtfsf
  964. 63  134    OP.        getCRdBImm    mtfsfi
  965. 31  292    OP        getRs        mtmsr,
  966. 31  934    OP        getSPRRs    mtspr,
  967. 31  420    OP        getSRRs        mtsr,
  968. 31    484    OP        getRsb        mtsrin,
  969. 31   75    OP.        getRdab        mulhw
  970. 31   11    OP.        getRdab        mulhwu
  971. 31  235    OPo.    getRdab        mullw
  972. 7    0    OP        getRdaSImm    mulli,
  973. 31  476    OP.        getRasb        nand
  974. 31  104    OPo.    getRda        neg
  975. 31  124    OP.        getRasb        nor
  976. 31  444    OP.        getRasb        or
  977. 31  412    OP.        getRasb        orc
  978. 24    0    OP        getRasImm    ori,
  979. 25    0    OP        getRasImm    oris,
  980. 19  100    OP        getNull        rfi,
  981. 20    0    OP.        getRasSHMBME rlwimi
  982. 21    0    OP.        getRasSHMBME rlwinm
  983. 23    0    OP.        getRasbMBME  rlwnm
  984. 17    2    OP        getNull        sc,
  985.  
  986. 31   24    OP.        getRasb        slw
  987. \ 31 794OP.        getRasb        srad
  988. 31  792    OP.        getRasb        sraw
  989. 31  824    OP.        getRasSH    srawi
  990. \ 31 539OP.        getRasb        srd
  991. 31  536    OP.        getRasb        srw
  992. 38    0    OP        getRsaDisp    stb,
  993. 39    0    OP        getRsaDisp    stbu,
  994. 31  494 OP        getRsab        stbux,
  995. 31  430 OP        getRsab        stbx,
  996. 54    0    OP        getFRsRaDisp stfd,
  997. 55    0    OP        getFRsRaDisp stfdu,
  998. 31 1518    OP        getFRsRab    stfdux,
  999. 31 1454    OP        getFRsRab    stfdx,
  1000. 52    0    OP        getFRsRaDisp stfs,
  1001. 53    0    OP        getFRsRaDisp stfsu,
  1002. 31 1390    OP        getFRsRab    stfsux,
  1003. 31 1326    OP        getFRsRab    stfsx,
  1004. 44    0    OP        getRsaDisp    sth,
  1005. 31 1836    OP        getRsab        sthbrx,
  1006. 45    0    OP        getRsaDisp    sthu,
  1007. 31  878    OP        getRsab        sthux,
  1008. 31  814    OP        getRsab        sthx,
  1009. 47    0    OP        getRsaDisp    stmw,
  1010. 31 1450    OP        getRsaNB    stswi,
  1011. 31 1322    OP        getRsab        stswx,
  1012. 36    0    OP        getRsaDisp    stw,
  1013. 31 1324    OP        getRsab        stwbrx,
  1014. 31  301    OP        getRsab        stwcx.,
  1015. 37    0    OP        getRsaDisp    stwu,
  1016. 31  366    OP        getRsab        stwux,
  1017. 31  302    OP        getRsab        stwx,
  1018. 31   40    OPo.    getRdab        subf
  1019. 31    8    OPo.    getRdab        subfc
  1020. 31    136    OPo.    getRdab        subfe
  1021. 08    0    OP        getRdaSImm    subfic,
  1022. 31    232    OPo.    getRda        subfme
  1023. 31    200    OPo.    getRda        subfze
  1024. 31 1196    OP        getNull        sync,
  1025. 31  612    OP        getRb        tlbie,
  1026. 31    8    OP        getTORab    tw,
  1027. 03    0    OP        getTORaSImm    twi,
  1028. 31  316    OP.        getRasb        xor
  1029. 26    0    OP        getRasImm    xori,
  1030. 27    0    OP        getRasImm    xoris,
  1031.  
  1032. \ vector ops:
  1033.  
  1034. 4    32        OP        getVdabc    vmhaddshs,
  1035. 4    33        OP        getVdabc    vmhraddshs,
  1036. 4    34        OP        getVdabc    vmladduhm,
  1037. 4    36        OP        getVdabc    vmsumubm,
  1038. 4    37        OP        getVdabc    vmsummbm,
  1039. 4    38        OP        getVdabc    vmsumuhm,
  1040. 4    39        OP        getVdabc    vmsumuhs,
  1041. 4    40        OP        getVdabc    vmsumshm,
  1042. 4    41        OP        getVdabc    vmsumshs,
  1043. 4    42        OP        getVdabc    vsel,
  1044. 4    43        OP        getVdabc    vperm,
  1045. 4    44        OP        getVdabSH    vsldoi,
  1046. 4    46        OP        getVdab        vmaddfp,
  1047. 4    47        OP        getVdabc    vnmsubfp,
  1048.  
  1049. 4    0        OP        getVdab        vaddubm,
  1050. 4    64        OP        getVdab        vadduhm,
  1051. 4    128        OP        getVdab        vadduwm,
  1052. 4    384        OP        getVdab        vaddcuw,
  1053. 4    512        OP        getVdab        vaddubs,
  1054. 4    576        OP        getVdab        vadduhs,
  1055. 4    640        OP        getVdab        vadduws,
  1056. 4    768        OP        getVdab        vaddsbs,
  1057. 4    832        OP        getVdab        vaddshs,
  1058. 4    896        OP        getVdab        vaddsws,
  1059.  
  1060. 4    1024    OP        getVdab        vsububm,
  1061. 4    1088    OP        getVdab        vsubuhm,
  1062. 4    1152    OP        getVdab        vsubuwm,
  1063. 4    1408    OP        getVdab        vsubcuw,
  1064. 4    1536    OP        getVdab        vsububs,
  1065. 4    1600    OP        getVdab        vsubuhs,
  1066. 4    1664    OP        getVdab        vsubuws,
  1067. 4    1792    OP        getVdab        vsubsbs,
  1068. 4    1856    OP        getVdab        vsubshs,
  1069. 4    1920    OP        getVdab        vsubsws,
  1070.  
  1071. 4    2        OP        getVdab        vmaxub,
  1072. 4    66        OP        getVdab        vmaxuh,
  1073. 4    130        OP        getVdab        vmaxuw,
  1074. 4    258        OP        getVdab        vmaxsb,
  1075. 4    322        OP        getVdab        vmaxsh,
  1076. 4    386        OP        getVdab        vmaxsw,
  1077.  
  1078. 4    514        OP        getVdab        vminub,
  1079. 4    578        OP        getVdab        vminuh,
  1080. 4    642        OP        getVdab        vminuw,
  1081. 4    770        OP        getVdab        vminsb,
  1082. 4    834        OP        getVdab        vminsh,
  1083. 4    898        OP        getVdab        vminsw,
  1084.  
  1085. 4    1026    OP        getVdab        vavgub,
  1086. 4    1090    OP        getVdab        vavguh,
  1087. 4    1154    OP        getVdab        vavguw,
  1088. 4    1282    OP        getVdab        vavgsb,
  1089. 4    1346    OP        getVdab        vavgsh,
  1090. 4    1410    OP        getVdab        vavgsw,
  1091.  
  1092. 4    4        OP        getVdab        vrlb,
  1093. 4    68        OP        getVdab        vrlh,
  1094. 4    132        OP        getVdab        vrlw,
  1095. 4    260        OP        getVdab        vslb,
  1096. 4    324        OP        getVdab        vslh,
  1097. 4    388        OP        getVdab        vslw,
  1098. 4    452        OP        getVdab        vsl,
  1099. 4    516        OP        getVdab        vsrb,
  1100. 4    580        OP        getVdab        vsrh,
  1101. 4    644        OP        getVdab        vsrw,
  1102. 4    708        OP        getVdab        vsr,
  1103. 4    772        OP        getVdab        vsrab,
  1104. 4    836        OP        getVdab        vsrah,
  1105. 4    900        OP        getVdab        vsraw,
  1106.  
  1107. 4    1028    OP        getVdab        vand,
  1108. 4    1092    OP        getVdab        vandc,
  1109. 4    1156    OP        getVdab        vor,
  1110. 4    1220    OP        getVdab        vxor,
  1111. 4    1284    OP        getVdab        vnor,
  1112.  
  1113. 4    1540    OP        getVd        mfvscr,
  1114. 4    1604    OP        getVb        mtvscr,
  1115.  
  1116. 4    6        OPv.    getVdab        vcmpequb
  1117. 4    70        OPv.    getVdab        vcmpequh
  1118. 4    134        OPv.    getVdab        vcmpequw
  1119. 4    198        OPv.    getVdab        vcmpequfp
  1120. 4    454        OPv.    getVdab        vcmpgefp
  1121. 4    518        OPv.    getVdab        vcmpgtub
  1122. 4    582        OPv.    getVdab        vcmpgtuh
  1123. 4    646        OPv.    getVdab        vcmpgtuw
  1124. 4    710        OPv.    getVdab        vcmpgtfp
  1125. 4    774        OPv.    getVdab        vcmpgtsb
  1126. 4    838        OPv.    getVdab        vcmpgtsh
  1127. 4    902        OPv.    getVdab        vcmpgtsw
  1128. 4    966        OPv.    getVdab        vcmpbfp
  1129.  
  1130. 4    8        OP        getVdab        vmuloub,
  1131. 4    72        OP        getVdab        vmulouh,
  1132. 4    264        OP        getVdab        vmulosb,
  1133. 4    328        OP        getVdab        vmulosh,
  1134. 4    520        OP        getVdab        vmuleub,
  1135. 4    584        OP        getVdab        vmuleuh,
  1136. 4    776        OP        getVdab        vmulesb,
  1137. 4    840        OP        getVdab        vmulesh,
  1138. 4    1544    OP        getVdab        vsum4ubs,
  1139. 4    1800    OP        getVdab        vsum4sbs,
  1140. 4    1608    OP        getVdab        vsum4shs,
  1141. 4    1672    OP        getVdab        vsum2sws,
  1142. 4    1928    OP        getVdab        vsumsws,
  1143.  
  1144. 4    10        OP        getVdab        vaddfp,
  1145. 4    74        OP        getVdab        vsubfp,
  1146.  
  1147. 4    266        OP        getVdb        vrefp,
  1148. 4    330        OP        getVdb        vsqrtefp,
  1149. 4    394        OP        getVdb        vexptefp,
  1150. 4    458        OP        getVdb        vlogefp,
  1151. 4    522        OP        getVdb        vrfin,
  1152. 4    586        OP        getVdb        vrfiz,
  1153. 4    650        OP        getVdb        vrfip,
  1154. 4    714        OP        getVdb        vrfim,
  1155.  
  1156. 4    778        OP        getVdbUIMM5    vcfux,
  1157. 4    842        OP        getVdbUIMM5    vcfsx,
  1158. 4    906        OP        getVdbUIMM5    vctusx,
  1159. 4    970        OP        getVdbUIMM5    vctsxs,
  1160.  
  1161. 4    1034    OP        getVdab        vmaxfp,
  1162. 4    1098    OP        getVdab        vminfp,
  1163.  
  1164. 4    12        OP        getVdab        vmrghb,
  1165. 4    76        OP        getVdab        vmrghh,
  1166. 4    140        OP        getVdab        vmrghw,
  1167. 4    268        OP        getVdab        vmrglb,
  1168. 4    332        OP        getVdab        vmrglh,
  1169. 4    396        OP        getVdab        vmrglw,
  1170.  
  1171. 4    524        OP        getVdbUIMM5    vspltb,
  1172. 4    588        OP        getVdbUIMM5    vsplth,
  1173. 4    652        OP        getVdbUIMM5    vspltw,
  1174. 4    780        OP        getVdSIMM5    vspltisb,
  1175. 4    844        OP        getVdSIMM5    vspltish,
  1176. 4    908        OP        getVdSIMM5    vspltisw,
  1177.  
  1178. 4    1036    OP        getVdab        vslo,
  1179. 4    1100    OP        getVdab        vsro,
  1180. 4    14        OP        getVdab        vpkuhum,
  1181. 4    78        OP        getVdab        vpkuwum,
  1182. 4    142        OP        getVdab        vpkuhus,
  1183. 4    206        OP        getVdab        vpkuwus,
  1184. 4    270        OP        getVdab        vpkshus,
  1185. 4    334        OP        getVdab        vpkswus,
  1186. 4    398        OP        getVdab        vpkshss,
  1187. 4    462        OP        getVdab        vpkswss,
  1188.  
  1189. 4    526        OP        getVdb        vupkhsb,
  1190. 4    590        OP        getVdb        vupkhsh,
  1191. 4    654        OP        getVdb        vupklsb,
  1192. 4    718        OP        getVdb        vupklsh,
  1193. 4    782        OP        getVdab        vpkpx,
  1194. 4    846        OP        getVdb        vupkhpx,
  1195. 4    974        OP        getVdb        vupklpx,
  1196.  
  1197. \ vector data stream instructions:
  1198.  
  1199. 31    342                     OP2        getabVstrm    dst,
  1200. 31    342 $ 01000000 or        OP2        getabVstrm    dstt,
  1201. 31    374                        OP2        getabVstrm    dstst,
  1202. 31    $ 01000176                OP2        getabVstrm    dststt,
  1203. 31    822                        OP2        getVstrm    dss,
  1204. 31    822 $ 01000000 or        OP2        getVstrm    dssall,
  1205.  
  1206. \ vector loads and stores:
  1207.  
  1208. 31    6        OP2        getabVd        lvsl,
  1209. 31    7        OP2        getabVd        lvebx,
  1210. 31    39        OP2        getabVd        lvehx,
  1211. 31    71        OP2        getabVd        lvewx,
  1212. 31    103        OP2        getabVd        lvx,
  1213. 31    359        OP2        getabVd        lvxl,
  1214. 31    135        OP2        getabVd        stvebx,
  1215. 31    167        OP2        getabVd        stvehx,
  1216. 31    199        OP2        getabVd        stvewx,
  1217. 31    231        OP2        getabVd        stvx,
  1218. 31    487        OP2        getabVd        stvxl,
  1219.  
  1220.  
  1221.  
  1222. \  Assembler Macro Definitions
  1223.  
  1224. \ Branching macros
  1225.  
  1226. : bcPatch  ( instr addr\dest addr )
  1227.     over - 13 checkAddress 
  1228.     hex# 0000FFFC and over @ hex# FFFF0003 and or swap ! ;
  1229.  
  1230. : bPatch  ( instr addr\dest addr )
  1231.     over - 24 checkAddress 
  1232.     hex# 03FFFFFC and over @ hex# FC000003 and or swap ! ;
  1233.  
  1234. : invertCondition  ( condition -- condition' )
  1235.     dup hex# 200 and 0= IF    \ make sure it uses conditions
  1236.         hex# 100 xor        \ flip BO[1]
  1237.     THEN ;
  1238.     
  1239. : if,  ( condition -- addr\2 )
  1240.     invertCondition codehere swap bc,
  1241.     codehere 4- 2 ;
  1242.  
  1243. : else,   ( addr\2 -- addr\3 )
  1244.     2 ?pairs codehere 4+ bcPatch
  1245.     codehere b,
  1246.     codehere 4- 3 ;
  1247.     
  1248. : then,  ( [addr\2] or [addr\3] -- )
  1249.     dup 3 = IF
  1250.         3 ?pairs codehere bpatch
  1251.     ELSE
  1252.         2 ?pairs codehere bcPatch
  1253.     THEN ;
  1254.  
  1255. : begin,  ( -- addr\1 )
  1256.     codehere 1 ;
  1257.  
  1258. : while,  ( condition -- addr\4 )
  1259.     if, 2+ ;
  1260.  
  1261. : bcBackwhiles  ( [addr\4]* -- )
  1262.     begin
  1263.         dup 4 =
  1264.     while
  1265.         drop codehere 4+ bcPatch
  1266.     repeat ;
  1267.  
  1268. : again,  ( addr\1[\addr\4]* -- )
  1269.     bcBackwhiles
  1270.     1 ?pairs
  1271.     b, ;
  1272.     
  1273. : repeat,  ( addr\1[\addr\4]* -- )
  1274.     again, ;
  1275.  
  1276. : until,  ( addr\1[\addr\4]*\condition -- )
  1277.     >R bcBackwhiles
  1278.     1 ?pairs
  1279.     R> invertCondition bc, ;
  1280.  
  1281. \ these are simplified mnemonics from PowerPC manual
  1282.  
  1283. : nop,  ( -- )  r0 r0 r0 or, ;
  1284.  
  1285. : li,        ( rA\SIMM -- | load immediate )                r0 swap addi, ;
  1286. : lis,        ( rA\SIMM -- | load immediate shifted )        r0 swap addis, ;
  1287. : lli,        ( rA\SLIMM -- | load long immediate )
  1288.     dup 0=
  1289.     IF    li,
  1290.      ELSE
  1291.         2dup extend dup  \ rA\SLIMM\rA\simm\simm
  1292.         IF    li,
  1293.             dup Hi2Lo swap hex# 8000 and IF \ sign bit set in lo 16 bits?
  1294.             1+ Lo2
  1295.         THEN
  1296.         dup IF extend addis, ELSE 2drop THEN
  1297.         ELSE        \ lo half is 0
  1298.             2drop Hi2Lo extend lis,
  1299.         THEN
  1300.     THEN ;
  1301.  
  1302. (* ***
  1303. old versions:
  1304.  
  1305. : li,  ( rA\SIMM -- | load immediate )  r0 swap addi, ;
  1306. : lis,  ( rA\SIMM -- | load immediate shifted )  r0 swap addis, ;
  1307. : lli,  ( rA\SLIMM -- | load long immediate )
  1308.         2dup extend li,
  1309.         dup Hi2Lo swap hex# 8000 and IF    \ sign bit set in lo 16 bits?
  1310.             1+ Lo2
  1311.         THEN
  1312.         ?dup IF extend addis, ELSE drop THEN ;
  1313.  
  1314. *** *)
  1315.  
  1316. : lui,  ( rA SIMM -- | load immediate )        lli, ;
  1317. : la,  ( rD SIMM\rA -- | load address )        swap addi, ;
  1318. : move,  ( rA rS -- )    dup or, ;
  1319. : move.,  ( rA rS -- )    dup or., ;
  1320. : mr,    ( rA rS -- )    dup or, ;            \ "move reg" = same as move,
  1321. : mr.,    ( rA rS -- )    dup or., ;
  1322. : not,  ( rA rS -- )    dup nor, ;
  1323. : not.,  ( rA rS -- )    dup nor., ;
  1324. : subi,  ( rA SIMM -- ) negate addi, ;
  1325. : slwi,  ( rA rS\n -- ) 0 over 31 swap - rlwinm, ;
  1326.  
  1327. \ : srwi,  ( rA rS\n -- ) 32 over - swap 31 rlwimi, ;        \ bug, I think
  1328. : srwi,  ( rA rS\n -- ) 32 over - swap 31 rlwinm, ;
  1329.  
  1330. : mtlr,  ( rA -- ) lr swap mtspr, ;
  1331. : mflr,  ( rA -- ) lr mfspr, ;
  1332. : mtctr,  ( rA -- ) ctr swap mtspr, ;
  1333. : mfctr,  ( rA -- ) ctr mfspr, ;
  1334. : clr,  ( rA -- ) dup dup subf, ;
  1335.  
  1336.  
  1337. \ Registers:
  1338.  
  1339. \ Important note: these definitions MUST MATCH those in ppc1!
  1340.  
  1341.  
  1342. : rOSSP            r1  ;    \ Operating system stack pointer
  1343. : rTOC          r2  ;    \ table of contents pointer
  1344. : rMainCode        r13 ;    \ base addr regs
  1345. : rMainData        r14 ; 
  1346. : rModCode        r15 ;
  1347. : rModData        r16 ;
  1348. : rRP            r17 ;    \ return stack pointer
  1349. : rSP            r18 ;    \ data stack pointer
  1350. : rFSP            r19 ;    \ floating stack pointer
  1351. : rObjBase        r20 ;    \ current object base addr
  1352. : rI            r21 ;    \ DO index
  1353. : rDo_limit        r22 ;    \ DO limit
  1354.  
  1355.  
  1356. \ Note: R11, R12, CR6, & CR7 are designated as scratch registers by Apple
  1357.  
  1358. \ : rX    r11 ;
  1359. \ : rY    r12 ;
  1360. \ : crX    cr6 ;
  1361. \ : crY    cr7 ;
  1362.  
  1363. \ r0 is also scratch but must be used carefully as it is special in some
  1364. \  instructions
  1365.  
  1366.  
  1367. \ Some Forth macros
  1368.  
  1369. \ dicaddr generates a dictionary address as offset, base-reg (as needed
  1370. \  for a load or store).
  1371.  
  1372. \ Usage:
  1373. \    r4    ' someWord    dicaddr  lwz,
  1374.  
  1375. : dicaddr { addr \ reg disp -- disp reg }
  1376.     addr b&d  -> disp  -> reg
  1377.     reg
  1378.     CASE[ mainData_reg    ]=>        rMainData
  1379.         [ modData_reg    ]=>        rModData
  1380.         [ mainCode_reg    ]=>        rMainCode
  1381.         [ modCode_reg    ]=>        rModCode
  1382.     DEFAULT=>
  1383.     ]CASE
  1384.     disp swap
  1385. ;
  1386.  
  1387. \ dicaddr, generates a dictionary address in the designated register,
  1388. \  using addi .  Note that it must be within 32k distance from where
  1389. \  the reg points, or we're out of luck.
  1390.  
  1391. \ Usage:
  1392. \    r4    ' someWord 2+    dicaddr,
  1393.  
  1394. : dicaddr, ( addr -- )
  1395.     dicaddr  swap addi,
  1396. ;
  1397.  
  1398.  
  1399. : tst,  ( reg -- )  0 cmpi, ;
  1400.  
  1401. : rts,  ( -- )  bclr, ;
  1402.  
  1403. decimal
  1404.  
  1405. false    value    pasm_done?
  1406.  
  1407.  
  1408. : FIND_IN_PASM    \ ( s255 -- cfa true | -- s255 false )
  1409.     find: pasmMod  ;
  1410.  
  1411.  
  1412. : ENTERCODE        \ begin assembly outside of a colon definition
  1413.     lock: pasmMod
  1414.     ['] find_in_pasm  -> extraFind    \ look up words in pasm first.  Exclude
  1415.                                     \  locals and class stuff for the duration
  1416.     false -> pasm_done?
  1417.     code_align
  1418. ;
  1419.  
  1420.  
  1421. \ :PPC_CODE begins a code definition.  We set up a header specifying
  1422. \ no named parms/locals and 2 results.  This means that the top 2 stack
  1423. \ cells will be in r4 and r3 on both entry and exit, which keeps things
  1424. \ simple.
  1425.  
  1426. : :PPC_CODE
  1427.     ppc_header
  1428.     $ BE00 codeW,            \ handler code for PPC colon defns    
  1429.     $ 4200 codeW,            \ non-leaf, modifies ctr (must be conservative),
  1430.                             \  no named parms/locals, 2 results
  1431.     entercode
  1432.     BEGIN
  1433.         topfile -> source-ID  (Frefill)  IF  interpret  THEN
  1434.         pasm_done?
  1435.     UNTIL  ;
  1436.  
  1437.  
  1438. : ;PPC_CODE
  1439.     0 -> extraFind
  1440.     unlock: pasmMod
  1441.     true -> pasm_done?
  1442.     ?exec  reveal
  1443. ;
  1444.  
  1445. \ ppc? not
  1446. \ [IF]
  1447. // disAsm
  1448. \ [THEN]
  1449.  
  1450. : rX    r11 ;
  1451. : rY    r12 ;
  1452. : crX    cr6 ;
  1453. : crY    cr7 ;
  1454.